home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
fb386
/
graf
/
a21.bas
< prev
next >
Wrap
BASIC Source File
|
1993-11-30
|
2KB
|
58 lines
1000 'A21.BAS***************************************************T.K.MOSAKU
1010 SCREEN@ 2:WINDOW (0,0)-(640,480):CLS
1015 CD PLAY 2
1020 A1$=" 一つの球形を描き, "
1030 A2$="GET@ 命令で取り込み, PUT@ 命令で表示します。 "
1040 A3$="途中で球形の色が, 背景とともに4度変わります。"
1050 A1=LEN(A1$):B1=(80-A1)\2:LOCATE 0, 9:PRINT SPACE$(B1)+A1$
1060 A2=LEN(A2$):B2=(80-A2)\2:LOCATE 0,11:PRINT SPACE$(B2)+A2$
1070 A3=LEN(A3$):B3=(80-A3)\2:LOCATE 0,13:PRINT SPACE$(B3)+A3$
1080 T1=TIME:S=1
1090 FOR J=0 TO 255
1100 PALETTE J,[J,0,0],1
1110 NEXT
1120 X0=100:Y0=100:WW=50
1130 '
1140 GOSUB *CUBE
1150 DIM A%(6000)
1160 GET@A (X0-WW,Y0-WW)-(X0+WW,Y0+WW),A%
1170 '
1180 T1=TIME:CLS
1190 X0=20:Y0=10:X2=5:Y2=3.7!:GOSUB *MAIN
1200 X0=20:Y0=10:X2=5:Y2=2 :GOSUB *MAIN
1210 X0=20:Y0=10:X2=5:Y2=.3! :GOSUB *MAIN
1220 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "描き上げる時間--";T;"秒。"
1230 GOTO 1330
1240 *MAIN
1250 FOR J=1 TO 12
1260 X1=X2*(J+1):Y1=Y2*(J+1)
1270 X0=X0+X1:Y0=Y0+Y1
1280 XX=.1!*(J+1):YY=.1!*(J+1)
1290 PUT@A (X0,Y0)-(X0+100,Y0+100),A%,MATTE,XX,YY,0
1300 NEXT
1310 RETURN
1320 '
1330 WAIT 200:T1=TIME
1340 FOR J=0 TO 255:PALETTE J,[255-J,255-J, 0],1:NEXT
1350 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒。"
1360 '
1370 WAIT 200:T1=TIME
1380 FOR J=0 TO 255:PALETTE J,[J, 0,255-J],1:NEXT
1390 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒。"
1400 '
1410 WAIT 200:T1=TIME
1420 FOR J=0 TO 255:PALETTE J,[255-J,255-J,255-J],1:NEXT
1430 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒。"
1440 '
1450 WAIT 200:T1=TIME
1460 FOR J=0 TO 255:PALETTE J,[J, J, J],1:NEXT
1470 T2=TIME:T=T2-T1:LOCATE 5,22:PRINT "色を変える時間--";T;"秒。"
1480 '
1490 WAIT 200
1500 GOTO 1550
1510 '
1520 *CUBE
1530 FOR I=0 TO 255:CIRCLE (X0,Y0),WW*(255-I)/255,%I:NEXT
1540 RETURN
1550 '